home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / moon-pha < prev    next >
Text File  |  1995-03-31  |  5KB  |  199 lines
  1. Article 5680 of comp.sys.handhelds:
  2. Path: en.ecn.purdue.edu!noose.ecn.purdue.edu!samsung!spool.mu.edu!cs.umn.edu!uc!norge.unet.umn.edu!fin
  3. From: fin@norge.unet.umn.edu (Craig A. Finseth)
  4. Newsgroups: comp.sys.handhelds
  5. Subject: revised phase of moon program for the HP-48SX
  6. Message-ID: <3849@uc.msc.umn.edu>
  7. Date: 8 Apr 91 16:12:23 GMT
  8. Sender: news@uc.msc.umn.edu
  9. Organization: Univ Netw Serv, Univ of Minn
  10. Lines: 185
  11.  
  12. Written by: Craig Finseth, University of Minnesota
  13. When: 6 Apr 1991
  14. What: Phase of Moon Display
  15.  
  16. This version incorporates the CIRCLE routine written by Mark Power and
  17. published in Datafile V10N2.  Circle drawing time has been reduced
  18. from 14 sec to about 8 sec.
  19.  
  20. MPHASE    Calculate and show the phase of the moon for the current date/time
  21. MTIME    Calculate and show the moon time string for the current date/time
  22. MFRAC    Calculate the moon phase fraction (0 new moon; .25 first quarter;
  23.     .5 full moon; .75 last quarter)
  24. FLIP    Invert the screen.
  25. MPLOT    Internal to MPHASE: Plot the crescent
  26. MLINE    Internal to MPHASE: Draw a line of the crescent
  27.  
  28. MFINI    Internal to MPHASE: display the stars, call FLIP
  29. CIRCLE    Circle drawing routine
  30. D4        Utility routine for CIRCLE: does not support filled circle
  31.  
  32. Notes:
  33.  
  34. - The algorithm used is known to be incorrect (it uses a single sin
  35. term: the correct calculation uses about 30 such terms).  The
  36. algorithm is retained in homage to the original version written at the
  37. MIT Architecture Machine Group for its MagicSix operating system in
  38. the late 1970s.  Everything else, including the constant terms in the
  39. algorithm, has been rewritten and refined.
  40.  
  41. - If you want to generalize the date/time caluclated for, change
  42. MFRAC.
  43.  
  44. - You can omit the flip by removing the call to FLIP from MFINI.
  45.  
  46. - You can omit both the flip and the stars by removing the call to
  47. MFINI from MPHASE.
  48.  
  49. - The base time for new moon is 12 Jan 1975 at 10:21 am GMT (4:21 AM
  50. CST).
  51.  
  52. - The moon cycle is assumed to by 42,532 minutes long.
  53.  
  54. - The stars displayed are just constant random bits: they do not
  55. correspond to real stars.
  56.  
  57. Checksum: #49b6h
  58. Size: 1772.5
  59. ------------------------------------------------------------
  60. %%HP: T(3)A(D)F(.);
  61. DIR
  62.   MPHASE
  63.     \<< RCLF DEG
  64. ERASE { # 0h # 0h }
  65. PVIEW { # 40h # 1Ch
  66. } # 1Ah CIRCLE 26
  67. 28 MFRAC MPLOT
  68. MFINI 7 FREEZE STOF
  69.     \>>
  70.   MTIME
  71.     \<< MFRAC \-> X
  72.       \<<
  73.         IF X .25 <
  74.         THEN "NM+"
  75.         ELSE
  76.           IF X .5 <
  77.           THEN
  78. "FQ+"
  79.           ELSE
  80.             IF X
  81. .75 <
  82.             THEN
  83. "FM+"
  84.             ELSE
  85. "LQ+"
  86.             END
  87.           END
  88.         END X
  89.       \>> .25 MOD
  90. 42532 * SWAP OVER
  91. 1440 / IP \->STR +
  92. "d " + SWAP 1440
  93. MOD SWAP OVER 60 /
  94. IP \->STR + "h " +
  95. SWAP 60 MOD SWAP
  96. OVER IP \->STR + "m "
  97. + SWAP FP 60 * IP
  98. \->STR + "s" +
  99.     \>>
  100.   MFRAC
  101.     \<< 1.121975 DATE
  102. DDAYS TIME 4.21
  103. HMS- HMS\-> 24 / +
  104. 1440 * 42532 / FP
  105.     \>>
  106.   FLIP
  107.     \<< PICT PICT RCL
  108. NEG { # 0h # 0h }
  109. SWAP REPL
  110.     \>>
  111.   MPLOT
  112.     \<< \-> RA MI F
  113.       \<<
  114.         IF F .5 <
  115.         THEN F 360
  116. * COS RA * RA
  117.         ELSE RA NEG
  118. F .5 - 360 * COS RA
  119. *
  120.         END \-> L R
  121.         \<< 1 0
  122.           FOR x x
  123. ACOS SIN DUP MI x
  124. RA * + L R MLINE MI
  125. x RA * - L R MLINE
  126. RA INV NEG
  127.           STEP
  128.         \>>
  129.       \>>
  130.     \>>
  131.   MLINE
  132.     \<< \-> SC LI L R
  133.       \<< SC L * 64 +
  134. R\->B LI R\->B 2 \->LIST
  135. SC R * 64 + R\->B LI
  136. R\->B 2 \->LIST LINE
  137.       \>>
  138.     \>>
  139.   MFINI
  140.     \<< { # Ah # Ah }
  141. PIXON { # 6Eh # Fh
  142. } PIXON { # 64h
  143. # 32h } PIXON {
  144. # 1Eh # 29h } PIXON
  145. { # 1Fh # 29h }
  146. PIXON FLIP
  147.     \>>
  148.   CIRCLE
  149.     \<< B\->R DUP 2 * 3
  150. SWAP - 0 \-> y d x
  151.       \<<
  152.         IF DUP TYPE
  153. 1 ==
  154.         THEN C\->PX
  155.         END LIST\->
  156. DROP \-> xo yo
  157.         \<<
  158.           WHILE x y
  159. <
  160.           REPEAT xo
  161. x yo y D4 xo y yo x
  162. D4 6 x
  163.             IF d 0
  164. \>=
  165.             THEN
  166. 'y' DECR -
  167.             END 4 *
  168. + 'd' STO+ 'x' INCR
  169. DROP
  170.           END
  171.           IF x y ==
  172.           THEN xo x
  173. yo y D4
  174.           END
  175.         \>>
  176.       \>>
  177.     \>>
  178.   D4
  179.     \<< DUP2 - 5
  180. ROLLD + 4 ROLLD
  181. DUP2 - 5 ROLLD + \->
  182. nx py ny px
  183.       \<< px py 2
  184. \->LIST px ny 2 \->LIST
  185. nx py 2 \->LIST nx ny
  186. 2 \->LIST PIXON PIXON
  187. PIXON PIXON
  188.       \>>
  189.     \>>
  190. END
  191.  
  192. Craig A. Finseth            fin@unet.umn.edu [CAF13]
  193. University Networking Services        +1 612 624 3375 desk
  194. University of Minnesota            +1 612 625 0006 problems
  195. 130 Lind Hall, 207 Church St SE        +1 612 626 1002 FAX
  196. Minneapolis MN 55455-0134, U.S.A.
  197.  
  198.  
  199.